home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / utilitys / 81 / bccstuff / wipedemo.lst < prev    next >
Encoding:
File List  |  1987-09-03  |  3.0 KB  |  76 lines
  1. ' ************************************************************
  2. ' ***** Wipedemo.lst by R. Warner & BC Computing 5/11/87 *****
  3. ' ****************** All rights reserved *********************
  4. ' ************************************************************
  5. '
  6. C_num=0
  7. De_rezz=Xbios(4)             ! find current screen resolution
  8. If De_rezz=0 Then            ! 0=Low Res
  9.   C_num=16                   ! number of available colors
  10.   X_width=320                ! max screen width
  11.   Y_height=200               ! max screen height
  12. Else
  13.   If De_rezz=1 Then          ! 1=Medium Res !
  14.     C_num=4                  ! see above !
  15.     X_width=640
  16.     Y_height=200
  17.   Else
  18.     If De_rezz=2 Then        ! 2=High Res !
  19.       C_num=2                ! see top !
  20.       X_width=640
  21.       Y_height=400
  22.     Endif
  23.   Endif
  24. Endif
  25. Dim Sys_pal%(15,3)           ! save room for default system pallette
  26. @Get_sys_pal
  27. Graphmode 1                  ! 1=replace 2=transparent 3=xor 4=rev. transparent
  28. Defline 1,1,0,0   !10        ! (1,1,0,0 is default) type,width,endstyle,endstyle
  29. '                            ! type must be <= 6, endstyle must be <= 2
  30. For Nxt_culor=C_num Downto 0 ! if a single wipe is desired, then -
  31.   @Wipe(Nxt_culor)           ! the numeric arg is a SINGLE color pallette value
  32. Next Nxt_culor               ! instead of running thru the pallette...
  33. '                            ! delete the previous for...next loop for 1 value
  34. ' @Wipe(N)                   ! and replace the @Wipe(nxt_culor) with @Wipe(N)
  35. '                            ! where N=the wipe color. Must be less than C_num!
  36. @Reset_sys_pal                  ! this restores the system pallette if need be...
  37. ' Cls                        ! this may or may not be necessary...
  38. End
  39. Procedure Wipe(Culor)        ! 0-15 for lores, 0-3 for medres, 0-1 for hires
  40.   Color Culor                ! color passed as value in @wipe(n) where n=culor
  41.   For S1%=0 To 0.5    !1     ! slide in color from the top
  42.     '                        ! 0.5 slides colors over each other...
  43.     '                        ! 1 slides white (or background) in between wipe
  44.     For S2%=S1%+0 To X_width ! width of screen detirmined by 4th arg (i.e. 640)
  45.       '                      ! for bottom slide-in (instead of top) use:
  46.       '                      ! s2%,0,s2%,x_width   (in place of the next line)
  47.       Line 0,S2%,X_width,S2% ! height "      " determined by 3rd arg (i.e. 200)
  48.     Next S2%
  49.   Next S1%
  50. Return
  51. Procedure Get_sys_pal
  52.   For Pal_reg=0 To 15
  53.     Dpoke Contrl,26
  54.     Dpoke Contrl+2,0
  55.     Dpoke Contrl+6,2
  56.     Dpoke Intin,Pal_reg
  57.     Dpoke Intin+2,0
  58.     Vdisys
  59.     Sys_pal%(Pal_reg,0)=Dpeek(Intout+2)
  60.     Sys_pal%(Pal_reg,1)=Dpeek(Intout+4)
  61.     Sys_pal%(Pal_reg,2)=Dpeek(Intout+6)
  62.   Next Pal_reg
  63. Return
  64. Procedure Reset_sys_pal
  65.   For Pal_reg=0 To 15
  66.     Dpoke Contrl,14
  67.     Dpoke Contrl+2,0
  68.     Dpoke Contrl+6,4
  69.     Dpoke Intin,Pal_reg
  70.     Dpoke Intin+2,Sys_pal%(Pal_reg,0)
  71.     Dpoke Intin+4,Sys_pal%(Pal_reg,1)
  72.     Dpoke Intin+6,Sys_pal%(Pal_reg,2)
  73.     Vdisys
  74.   Next Pal_reg
  75. Return
  76.